home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / EGAVGA.SWG / 0016_IMAGEPUT.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  3KB  |  76 lines
  1. {Here is a small Program that illustrates the features of GetImage/PutImage that
  2. you would like to use:
  3. }
  4.  {$A+,B-,D+,E-,F-,G+,I-,L+,N-,O-,R-,S+,V-,X+}
  5.  {$M 16384,0,655360}
  6.  Uses Graph;
  7.  (* Turbo Pascal, Width= 20 Height= 23 Colors= 16 *)
  8.  Const
  9.    Pac: Array[1..282] of Byte = (
  10.           $13,$00,$16,$00,$00,$FE,$00,$00,$FE,$00,
  11.           $00,$FE,$00,$FF,$01,$FF,$03,$FF,$80,$03,
  12.           $FF,$80,$03,$FF,$80,$FC,$00,$7F,$07,$8F,
  13.           $C0,$07,$8F,$C0,$07,$8F,$C0,$F8,$00,$3F,
  14.           $1F,$77,$F0,$1F,$17,$F0,$1F,$17,$E0,$E0,
  15.           $70,$0F,$1F,$77,$E0,$1F,$37,$E0,$1F,$37,
  16.           $C0,$E0,$70,$1F,$3F,$77,$C0,$3F,$17,$C0,
  17.           $3F,$17,$80,$C0,$70,$3F,$7F,$8F,$80,$7F,
  18.           $8F,$80,$7F,$8F,$00,$80,$00,$7F,$7F,$FF,
  19.           $00,$7F,$FF,$00,$7F,$FE,$00,$80,$00,$FF,
  20.           $FF,$FE,$00,$FF,$FE,$00,$FF,$FC,$00,$00,
  21.           $01,$FF,$FF,$FC,$00,$FF,$FC,$00,$FF,$F8,
  22.           $00,$00,$03,$FF,$FF,$F8,$00,$FF,$F8,$00,
  23.           $FF,$F0,$00,$00,$07,$FF,$FF,$F0,$00,$FF,
  24.           $F0,$00,$FF,$E0,$00,$00,$0F,$FF,$FF,$F8,
  25.           $00,$FF,$F8,$00,$FF,$F0,$00,$00,$07,$FF,
  26.           $FF,$FC,$00,$FF,$FC,$00,$FF,$F8,$00,$00,
  27.           $03,$FF,$FF,$FE,$00,$FF,$FE,$00,$FF,$FC,
  28.           $00,$00,$01,$FF,$7F,$FF,$00,$7F,$FF,$00,
  29.           $7F,$FE,$00,$80,$00,$FF,$7F,$FF,$80,$7F,
  30.           $FF,$80,$7F,$FF,$00,$80,$00,$7F,$3F,$FF,
  31.           $C0,$3F,$FF,$C0,$3F,$FF,$80,$C0,$00,$3F,
  32.           $1F,$FF,$E0,$1F,$FF,$E0,$1F,$FF,$C0,$E0,
  33.           $00,$1F,$1F,$FF,$F0,$1F,$FF,$F0,$1F,$FF,
  34.           $E0,$E0,$00,$0F,$07,$FF,$C0,$07,$FF,$C0,
  35.           $07,$FF,$C0,$F8,$00,$3F,$03,$FF,$80,$03,
  36.           $FF,$80,$03,$FF,$80,$FC,$00,$7F,$00,$FE,
  37.           $00,$00,$FE,$00,$00,$FE,$00,$FF,$01,$FF,
  38.           $00,$00);
  39.  Var Size,Result: Word;
  40.      Gd, Gm: Integer;
  41.      P: Pointer;
  42.      F: File;
  43.  begin
  44.  { Find correct display/card-Type and initiallize stuff }
  45.    Gd := Detect;
  46.    InitGraph(Gd, Gm, 'd:\bp\bgi');
  47.    if GraphResult <> grOk then Halt(1); { Error initialize }
  48.    ClearDevice;
  49.  
  50.    SetFillStyle(SolidFill,Blue);
  51.    Bar(0,0,639,479);
  52.    P := @Pac;                                (* Pass the address of the   *)
  53.                                              (* Pac Constant to a Pointer *)
  54.    PutImage(1,1,P^,NormalPut);               (* Display image             *)
  55.  
  56.    Size := ImageSize(1,1,20,23) { Get size of your picture };
  57.    GetMem(P, Size); { Get memory from heap }
  58.    GetImage(1,1,20,23,P^) { Capture picture itself in P^ };
  59.  
  60.    ClearDevice;
  61.  
  62.    Assign(F,'IMAGE');
  63.    reWrite(F,1);
  64.    BlockWrite(F,P^,Size,Result) { Put picture (from P^) in File F };
  65.    if Ioresult <> 0 then Halt(2) { Error during BlockWrite I/O };
  66.    if Result <> Size then Halt(3) { not enough data written to F };
  67.    close(F);
  68.    if Ioresult <> 0 then Halt(4) { Error during Close of F };
  69.  
  70.    PutImage(1,1,P^,NormalPut);
  71.    FreeMem(P,Size) { Free memory. This is GPP. };
  72.    ReadLn { Hit any key to continue };
  73.    ClearDevice;
  74.    CloseGraph;
  75.  end.
  76.